home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue45 / Cookies / DRBOBCGI.PAS next >
Encoding:
Pascal/Delphi Source File  |  2000-11-02  |  3.1 KB  |  134 lines
  1. unit DrBobCGI;
  2. interface
  3. type
  4.   TRequestMethod = (Unknown,Get,Post);
  5. var
  6.   RequestMethod: TRequestMethod = Unknown;
  7.  
  8. var
  9.   ContentLength: Integer = 0;
  10.  
  11.   function Value(const Field: ShortString): ShortString;
  12.   function CookieValue(const Field: ShortString): ShortString;
  13.  
  14. implementation
  15. uses
  16.   Windows, SysUtils;
  17.  
  18.   function _Value(const Field: ShortString;
  19.                   const Data: AnsiString; Sep: Char = '&'): ShortString;
  20.   { 1998/01/02: check for complete match of Field name }
  21.   { 1999/03/01: do conversion *after* searching fields }
  22.   var
  23.     i: Integer;
  24.     Str: String[3];
  25.     len: Byte absolute Result;
  26.   begin
  27.     len := 0; { Result := '' }
  28.     i := Pos('&'+Field+'=',Data);
  29.     if i = 0 then
  30.     begin
  31.       i := Pos(Field+'=',Data);
  32.       if i > 1 then i := 0
  33.     end
  34.     else Inc(i); { skip '&' }
  35.     if i > 0 then
  36.     begin
  37.       Inc(i,Length(Field)+1);
  38.       while Data[i] <> Sep do
  39.       begin
  40.         Inc(len);
  41.         if Data[i] = '%' then // special code
  42.         begin
  43.           Str := '$00';
  44.           Str[2] := Data[i+1];
  45.           Str[3] := Data[i+2];
  46.           Inc(i,2);
  47.           Result[len] := Chr(StrToInt(Str))
  48.         end
  49.         else Result[len] := Data[i];
  50.         Inc(i)
  51.       end
  52.     end
  53.   end {_Value};
  54.  
  55. const
  56.   Data: AnsiString = '';
  57.  
  58.   function Value(const Field: ShortString): ShortString;
  59.   begin
  60.     Result := _Value(Field, Data)
  61.   end;
  62.  
  63. const
  64.   Cookie: AnsiString = '';
  65.  
  66.   function CookieValue(const Field: ShortString): ShortString;
  67.   begin
  68.     Result := _Value(Field, Cookie, ';');
  69.     if Result = '' then Result := Cookie { debug }
  70.   end;
  71.  
  72. var
  73.   P: PChar;
  74.   i: Integer;
  75.   Str: ShortString;
  76.  
  77. initialization
  78.   P := GetEnvironmentStrings;
  79.   while P^ <> #0 do
  80.   begin
  81.     Str := StrPas(P);
  82.     if Pos('REQUEST_METHOD=',Str) > 0 then
  83.     begin
  84.       Delete(Str,1,Pos('=',Str));
  85.       if Str = 'POST' then RequestMethod := Post
  86.       else
  87.         if Str = 'GET' then RequestMethod := Get
  88.     end;
  89.     if Pos('CONTENT_LENGTH=',Str) = 1 then
  90.     begin
  91.       Delete(Str,1,Pos('=',Str));
  92.       ContentLength := StrToInt(Str)
  93.     end;
  94.     if Pos('QUERY_STRING=',Str) > 0 then
  95.     begin
  96.       Delete(Str,1,Pos('=',Str));
  97.       SetLength(Data,Length(Str)+1);
  98.       Data := Str
  99.     end;
  100.     if Pos('HTTP_COOKIE=',Str) > 0 then
  101.     begin
  102.       Delete(Str,1,Pos('=',Str));
  103.       SetLength(Cookie,Length(Str)+1);
  104.       Cookie := Str
  105.     end;
  106.     Inc(P, StrLen(P)+1)
  107.   end;
  108.   if RequestMethod = Post then
  109.   begin
  110.     SetLength(Data,ContentLength+1);
  111.     for i:=1 to ContentLength do read(Data[i]);
  112.     Data[ContentLength+1] := '&';
  113.   { if IOResult <> 0 then { skip }
  114.   end;
  115.   i := 0;
  116.   while i < Length(Data) do
  117.   begin
  118.     Inc(i);
  119.     if Data[i] = '+' then Data[i] := ' ';
  120.   { if Data[i] = '%' then // special code
  121.     begin
  122.       Str := '$00';
  123.       Str[2] := Data[i+1];
  124.       Str[3] := Data[i+2];
  125.       Delete(Data,i+1,2);
  126.       Data[i] := Chr(StrToInt(Str))
  127.     end }
  128.   end;
  129.   if i > 0 then Data[i+1] := '&'
  130.            else Data := '&';
  131. finalization
  132.   Data := ''
  133. end.
  134.